home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyProgress.p < prev    next >
Encoding:
Text File  |  1995-03-29  |  2.8 KB  |  132 lines  |  [TEXT/CWIE]
  1. unit MyProgress;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure PaintBarberPoll (r: rect; offset: integer);
  9.     procedure PaintProgress (r: rect; done, total: longInt);
  10.  
  11. implementation
  12.  
  13.     uses
  14.         Memory, FixMath, MyTypes, QLowLevel, MyUtils;
  15.  
  16.     var
  17.         gPPFilled,gPPEmpy:Rect;
  18.     
  19.     procedure PaintProgress (r: rect; done, total: longInt);
  20.         var
  21.             w, uw: integer;
  22.             dark,light:RGBColor;
  23.     begin
  24.         FrameRect(r);
  25.         InsetRect(r, 1, 1);
  26.         if total<0 then begin
  27.             EraseRect(r);
  28.         end else begin
  29.             w := r.right - r.left;
  30.             if total <= 0 then begin
  31.                 uw := 0;
  32.             end
  33.             else if done >= total then begin
  34.                 uw := w;
  35.             end
  36.             else begin
  37.                 uw := FracMul(w, FracDiv(done, total));
  38.             end;
  39.             gPPFilled:=r;
  40.             gPPEmpy:=r;
  41.             gPPFilled.right := r.left + uw;
  42.             gPPEmpy.left :=  r.left + uw;
  43.     
  44.             MakeRGBColor($4000,$4000,$4000,dark);
  45.             MakeRGBColor($CCCC,$CCCC,$FFFF,light);
  46.             RGBForeColor(dark);
  47.             RGBBackColor(light);
  48.             PaintRect(gPPFilled);
  49.             RGBForeColor(light);
  50.             RGBBackColor(dark);
  51.             PaintRect(gPPEmpy);
  52.             ForeColor(blackColor);
  53.             BackColor(whiteColor);
  54.         end;
  55.     end;
  56.  
  57.     type
  58.         MyPicture = record
  59.                 size: integer;
  60.                 r1: rect;
  61.                 data1: array[1..17] of integer;
  62.                 r2: rect;
  63.                 nintyeight: integer;
  64.                 rowbytes: integer;
  65.                 r3: rect;
  66.                 data2: array[1..34] of integer;
  67.                 r4: rect;
  68.                 r5: rect;
  69.                 mode: integer;
  70.                 eor: integer;
  71.             end;
  72.         MyPicturePtr = ^MyPicture;
  73.         MyPictureHandle = ^MyPicturePtr;
  74.  
  75.     procedure PaintBarberPoll (r: rect; offset: integer);
  76.         var
  77.             ph: MyPictureHandle;
  78.             rb: integer;
  79.             ts: integer;
  80.             p: ^integer;
  81.             i, j: integer;
  82.             b1, b2: integer;
  83.             o: integer;
  84.     begin
  85.         FrameRect(r);
  86.         InsetRect(r, 1, 1);
  87.         rb := (2 * (r.right - r.left) + 15) div 16 * 2;
  88.         ts := SizeOf(MyPicture) + (r.bottom - r.top) * (rb + 2);
  89.         ph := MyPictureHandle(NewHandle(ts));
  90.         HLock(handle(ph));
  91.         with ph^^ do begin
  92.             size := ts;
  93.             r1 := r;
  94.             r2 := r;
  95.             r3 := r;
  96.             r4 := r;
  97.             r5 := r;
  98.             nintyeight := $0098;
  99.             rowbytes := BOR(rb, $8000);
  100.             mode := 0;
  101.             StuffHex(@data1, '001102FF0C00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0001000A');
  102.             StuffHex(@data2, '0000000000000000004800000048000000000002000100020000000000000000000000000000000000000002000000000000000000014444444444440002CCCCCCCCFFFF');
  103.             p := @eor;
  104.             for i := r.top to r.bottom - 1 do begin
  105.                 p^ := BOR(BSL(rb + 1, 8), rb - 1);
  106.                 OffsetPtr(p, 2);
  107.                 o := BAND((offset + i) * 2, 31);
  108.                 if o < 16 then begin
  109.                     b1 := BSR($5555AAAA, o);
  110.                     b2 := BSR($AAAA5555, o);
  111.                 end
  112.                 else begin
  113.                     b1 := BSR($AAAA5555, o - 16);
  114.                     b2 := BSR($5555AAAA, o - 16);
  115.                 end;
  116.                 for j := 1 to rb div 2 do begin
  117.                     if odd(j) then begin
  118.                         p^ := b1;
  119.                     end
  120.                     else begin
  121.                         p^ := b2;
  122.                     end;
  123.                     OffsetPtr(p, 2);
  124.                 end;
  125.             end;
  126.             p^ := $00FF; {end of record}
  127.         end;
  128.         DrawPicture(PicHandle(ph), r);
  129.         DisposeHandle(handle(ph));
  130.     end;
  131.  
  132. end.